home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 1
/
Precision Software Applications Silver Collection Volume One (PSM) (1993).iso
/
tutor
/
dbase1iv.exe
/
DB4LESS4.ZIP
/
MAINBAR.PRG
< prev
next >
Wrap
Text File
|
1989-01-04
|
25KB
|
1,175 lines
**********************************************************************
* Program......: MAINBAR.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Main Menu for Job Cost System
* Description..: Menu actions
**********************************************************************
PROCEDURE MAINBAR
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="01"
DO SET01
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
SET NEAR ON
@ 0,0
TEXT
J O B C O S T S Y S T E M
ENDTEXT
@ 1,20 to 3,60 DOUBLE
ACTIVATE MENU MAINBAR
@ 4,1 CLEAR TO 6,77
*-- After menu
SET NEAR OFF
RETURN
*-- EOP MAINBAR
PROCEDURE SET01
ON KEY LABEL F1 DO 1HELP1
DO DBF01 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
SET BORDER TO
@ 4,1 TO 6,77 DOUBLE COLOR B/W
@ 5,2 CLEAR TO 5,76
@ 5,2 FILL TO 5,76 COLOR W+/N
@ 5,5 SAY "Data Entry" COLOR W+/N
@ 5,28 SAY "Retrieval" COLOR W+/N
@ 5,50 SAY "Other Options" COLOR W+/N
@ 5,72 SAY "Exit" COLOR W+/N
@ 22,00
ENDIF
RETURN
PROCEDURE DBF01
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT01
*-- Begin MAINBAR: BAR Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE "PAD_1" = PAD()
lc_new='Y'
DO DATAENT WITH " 01"
CASE "PAD_2" = PAD()
lc_new='Y'
DO DATARET WITH " 01"
CASE "PAD_3" = PAD()
lc_new='Y'
DO OTHEROPT WITH " 01"
CASE "PAD_4" = PAD()
*-- Return to caller
gc_quit='Q'
DEACTIVATE MENU && MAINBAR
RETURN
OTHERWISE
@ 24,00
@ 24,21 SAY "This item has no action. Press a key."
x=INKEY(0)
@ 24,00
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE MENU && MAINBAR
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: DATAENT.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Data Entry Menu for Job Cost System
* Description..: Menu actions
**********************************************************************
PROCEDURE DATAENT
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="02"
DO SET02
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP DATAENT
*-- After menu
RETURN
*-- EOP DATAENT
PROCEDURE SET02
ON KEY LABEL F1 DO 1HELP1
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE ACT02
*-- Begin DATAENT: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Time Slip File Manager"
DO TIME
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
close databases
CASE BAR() = 2
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Job File Manager"
DO JOB
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 3
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Customer File Manager"
DO CUSTOMER
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 4
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Employee File Manager"
DO EMP
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 5
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Billing Rate File Manager"
DO EMPRATE
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 6
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Function Code File Manager"
DO FUNCODE
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && DATAENT
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: DATARET.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Data Retrieval Menu for Job Cost System
* Description..: Menu actions
**********************************************************************
PROCEDURE DATARET
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="03"
DO SET03
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP DATARET
*-- After menu
RETURN
*-- EOP DATARET
PROCEDURE SET03
ON KEY LABEL F1 DO 1HELP1
DO DBF03 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE DBF03
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT03
*-- Begin DATARET: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
lc_new='Y'
DO REPORTS WITH " 03"
CASE BAR() = 2
lc_new='Y'
DO REVIEW WITH " 03"
CASE BAR() = 3
lc_new='Y'
DO LABELS WITH " 03"
CASE BAR() = 4
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
SET VIEW TO INVOICE.QBE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening INVOICE.QBE"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Invoices"
*-- Desc: Report
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
REPORT FORM INVOICE PLAIN NOEJECT
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && DATARET
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: OTHEROPT.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Other Options Menu
* Description..: Menu actions
**********************************************************************
PROCEDURE OTHEROPT
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="04"
DO SET04
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP OTHEROPT
*-- After menu
RETURN
*-- EOP OTHEROPT
PROCEDURE SET04
ON KEY LABEL F1 DO 1HELP1
DO DBF04 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE DBF04
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT04
*-- Begin OTHEROPT: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Back Up Data Files"
DO BACKUP
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 2
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
*-- Multi user file lock
DO Lockit WITH "1"
IF gn_error <> 0
gn_error=0
RETURN
ENDIF
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Create Lotus File: TIME.WKS"
lc_say='Copying records to TIME.WKS'
DO info_box WITH lc_say
SET TALK ON
*-- Desc: Copy records to TIME.WKS
COPY TO TIME.WKS TYPE WKS
SET TALK OFF
DEACTIVATE WINDOW Savescr
IF NETWORK()
UNLOCK
ENDIF
CASE BAR() = 3
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE EMP
IF "" <> DBF()
SET INDEX TO EMP
ENDIF
SET ORDER TO NAME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMP.DBF or index(es) EMP"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
*-- Multi user file lock
DO Lockit WITH "1"
IF gn_error <> 0
gn_error=0
RETURN
ENDIF
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Create Employee List ASCII File: EMP.TXT"
lc_say='Copying records to EMP.TXT'
DO info_box WITH lc_say
SET TALK ON
*-- Desc: Copy records to EMP.TXT
COPY TO EMP.TXT FIELDS fname,lname,address,city,state,zip,phone TYPE SDF
SET TALK OFF
DEACTIVATE WINDOW Savescr
IF NETWORK()
UNLOCK
ENDIF
CASE BAR() = 4
ACTIVATE WINDOW Savescr
SET SCOREBOARD ON
SET MESSAGE TO "Go to DOS Command Prompt. Type EXIT to Return to Job Cost System."
*-- Desc: Inline DO dBASE commands
RUN COMMAND
SET SCOREBOARD OFF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && OTHEROPT
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: REPORTS.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Reports Menu for Job Cost System
* Description..: Menu actions
**********************************************************************
PROCEDURE REPORTS
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="05"
DO SET05
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP REPORTS
*-- After menu
RETURN
*-- EOP REPORTS
PROCEDURE SET05
ON KEY LABEL F1 DO 1HELP1
DO DBF05 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE DBF05
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT05
*-- Begin REPORTS: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
SET VIEW TO JOBSTAT.QBE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening JOBSTAT.QBE"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Job Status Report for Incomplete Jobs"
*-- Desc: Report
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
REPORT FORM JOBSTAT PLAIN
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
CASE BAR() = 2
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE EMP
IF "" <> DBF()
SET INDEX TO EMP
ENDIF
SET ORDER TO NAME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMP.DBF or index(es) EMP"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Employee Phone List Report"
*-- Desc: Report
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
REPORT FORM EMP PLAIN
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
CASE BAR() = 5
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE FUNCODE
IF "" <> DBF()
SET INDEX TO FUNCODE
ENDIF
SET ORDER TO FUNCODE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening FUNCODE.DBF or index(es) FUNCODE"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Function Code List"
*-- Desc: List [<parameters>]
CLEAR
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
DISPLAY ALL OFF
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && REPORTS
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: REVIEW.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Review Menu for Job Cost System
* Description..: Menu actions
**********************************************************************
PROCEDURE REVIEW
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="06"
DO SET06
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP REVIEW
*-- After menu
RETURN
*-- EOP REVIEW
PROCEDURE SET06
ON KEY LABEL F1 DO 1HELP1
DO DBF06 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE DBF06
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT06
*-- Begin REVIEW: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
SET VIEW TO EMPPROG.QBE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMPPROG.QBE"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
lc_new='Y'
DO PROGFLDS WITH " 06"
CASE BAR() = 2
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
SET VIEW TO EMPRATE.QBE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMPRATE.QBE"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Browscr
SET SCOREBOARD ON
SET MESSAGE TO "Employees and their Billing Rates"
*-- Desc: Browse file - EMPRATE.QBE
BROWSE NOAPPEND NODELETE NOEDIT
SET SCOREBOARD OFF
DEACTIVATE WINDOW Browscr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && REVIEW
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: LABELS.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Labels Menu
* Description..: Menu actions
**********************************************************************
PROCEDURE LABELS
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="07"
DO SET07
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
ACTIVATE POPUP LABELS
*-- After menu
RETURN
*-- EOP LABELS
PROCEDURE SET07
ON KEY LABEL F1 DO 1HELP1
DO DBF07 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
@ 22,00
ENDIF
RETURN
PROCEDURE DBF07
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE TIME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening TIME.DBF"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT07
*-- Begin LABELS: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE EMP
SET ORDER TO NAME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMP.DBF"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Mailing Labels for Employees"
*-- Desc: LABEL command to call EMP
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
LABEL FORM EMP FOR ACTIVE
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
CASE BAR() = 2
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CUSTOMER
IF "" <> DBF()
SET INDEX TO CUSTOMER
ENDIF
SET ORDER TO CUSTNAME
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CUSTOMER.DBF or index(es) CUSTOMER"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Produce Mailing Labels for Customers"
*-- Desc: LABEL command to call CUSTOMER
gn_pkey = 0
DO PrintSet
IF gn_pkey <> 27 && esc
LABEL FORM CUSTOMER
DO Cleanup
ENDIF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && LABELS
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: PROGFLDS.PRG
* Author.......: Bruce Troutman
* Date.........: 1-04-89
* Notice.......: Interco International, Ltd.
* dBASE Ver....: dBase IV
* Generated by.: APGEN version 1.0
* Description..: Fields for PROG Dept View
* Description..: Menu actions
**********************************************************************
PROCEDURE PROGFLDS
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="08"
IF LEFT(entryflg,1)="A"
DO ACT08
RETURN
ENDIF
DO SET08
IF gn_error > 0
gn_error=0
RETURN
ENDIF
*-- Before menu code
lc_fldlst=''
ON KEY LABEL CTRL-W DEACTIVATE POPUP
IF TYPE("lc_window")="U"
DEFINE WINDOW ShowPick FROM 17,0 TO 21,60 DOUBLE
ACTIVATE WINDOW ShowPick
ENDIF
ACTIVATE SCREEN
ACTIVATE POPUP PROGFLDS
IF TYPE("lc_window")="U"
DEACTIVATE WINDOW ShowPick
RELEASE WINDOW ShowPick
ENDIF
ON KEY LABEL CTRL-W
IF RIGHT(lc_fldlst,1)=","
listval=LEFT(lc_fldlst,LEN(lc_fldlst)-1)
DO ACT08
ENDIF
*-- After menu
gn_ikey=27
RETURN
*-- EOP PROGFLDS
PROCEDURE SET08
ON KEY LABEL F1 DO 1HELP1
DO DBF08 && open menu level database
IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W+/B
SET COLOR OF MESSAGES TO W+/N
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO B/W
SET COLOR OF BOX TO B/W
SET COLOR OF INFORMATION TO B/W
SET COLOR OF FIELDS TO B/W
ENDIF
ENDIF
RETURN
PROCEDURE DBF08
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
SET VIEW TO EMPPROG.QBE
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening EMPPROG.QBE"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN
PROCEDURE ACT08
*-- Begin PROGFLDS: STRUCTURE Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
ACTIVATE WINDOW Browscr
SET SCOREBOARD ON
SET MESSAGE TO "Review Employees in the Programming Department"
*-- Desc: Browse file -
BROWSE FIELDS &listval
SET SCOREBOARD OFF
DEACTIVATE WINDOW Browscr
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && PROGFLDS
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN